home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Tubes / Tubes.AMOS / Tubes.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1999-05-29  |  11.8 KB  |  471 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *            Tubes V1.0             *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. Hide 
  9.  Extension_8_0FF2 3
  10.  Extension_8_0FF2 5
  11. Dim D(31,1)
  12. Dim F(12,9)
  13. Dim HISC(15,1),HISC$(15)
  14. LOAHISC
  15. Restore TUBES
  16. Dim P(12,4)
  17. VO=0 : TB=0
  18. Global D(),F(),P(),VO,TB,HISC(),HISC$()
  19. For A=0 To 12
  20.   For B=0 To 4
  21.     Read P(A,B)
  22.   Next 
  23. Next 
  24. INIT
  25. SCORE=0
  26. Do 
  27.   TITLE
  28.   Exit If Param
  29.   LEVEL=1 : SCORE=0
  30.   Do 
  31.     REBUILDGFX
  32.     NUMTUBES=Min(15+LEVEL*5,130) : TIME=45+LEVEL*15 : LEVDIF=Max(400-LEVEL*30,50)
  33.     SETTUBES
  34.     WATERGO
  35.     Exit If Param
  36.     Inc LEVEL
  37.   Loop 
  38.   GAMEOVER
  39. Loop 
  40. QUIT
  41. End 
  42. TUBES:
  43.   Data 0,0,0,0,0
  44.   Data 1,0,1,0,1
  45.   Data 0,1,1,1,0
  46.   Data 1,1,1,1,1
  47.   Data 1,1,1,1,1
  48.   Data 0,0,2,1,1
  49.   Data 0,1,2,0,1
  50.   Data 1,0,2,1,0
  51.   Data 1,1,2,0,0
  52.   Data 0,0,1,0,1
  53.   Data 1,0,1,0,0
  54.   Data 0,0,1,1,0
  55.   Data 0,1,1,0,0
  56.  
  57. Procedure INIT
  58.   Screen Open 2,320,256,2,0 : Screen Hide 
  59.   Curs Off 
  60.    Extension_8_1204 10
  61.   TB=Text Base
  62.   Unpack 9 To 1 : Screen Hide 
  63.   For A=0 To 12
  64.     Get Block A+1,A*16,0,16,16,1
  65.     Get Bob A+1,A*16,0 To A*16+16,16
  66.   Next 
  67.   For A=0 To 15
  68.     Colour A+16, Extension_8_0EE8( Colour(A),$448,0 To $FFF)
  69.   Next 
  70.   Screen Open 0,320,256,16,0
  71.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  72.   For A=0 To 31 : Colour A,0 : Next 
  73. End Proc
  74. Procedure QUIT
  75.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  76.   Screen Close 1
  77.   Screen Close 2
  78.   Screen Close 0
  79. End Proc
  80. Procedure TITLE
  81.   Shared SCORE,LEVEL
  82.   Screen 2
  83.   Get Palette 1
  84.   For A=0 To 7 : Colour A, Extension_8_0EE8( Colour(A),-$222,0 To $FFF) : Next 
  85.   For A=0 To 7 : Colour A+8, Colour(A) : Next 
  86.   Screen 0
  87.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  88.   Cls 0
  89.   Screen Copy 1,0,16,320,80 To 0,0,0
  90.   Ink 15,0 : Set Pattern -1
  91.   Bar 0,64 To 320,256
  92.   Put Block 6,0,64
  93.   Put Block 7,304,64
  94.   Put Block 8,0,240
  95.   Put Block 9,304,240
  96.   For A=1 To 18
  97.     Put Block 3,A*16,64
  98.     Put Block 3,A*16,240
  99.   Next 
  100.   For A=5 To 14
  101.     Put Block 2,0,A*16
  102.     Put Block 2,304,A*16
  103.   Next 
  104.    Extension_8_10C6 64
  105.    Extension_8_10F2 0
  106.    Extension_8_108E 3
  107.   Fade 1 To 2 : For A=0 To 15 : Multi Wait : Next 
  108.   Clear Key 
  109.   PAG=0
  110.   If SCORE>HISC(15,0) Then Gosub ENTERHISC
  111.   Do 
  112.     If PAG=0 Then Gosub CREDIZ Else Gosub HISCORE
  113.      Extension_8_128A 2
  114.      Extension_8_12B2 2,0 To 0,3
  115.      Extension_8_1258 : Wait Vbl 
  116.     Screen 2 : For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  117.     Fade 2 To 2
  118.     For A=0 To 31 : Multi Wait : Next 
  119.     For A=0 To 199
  120.       I$=Inkey$ : MK=Mouse Key
  121.       Multi Wait 
  122.       Exit If I$<>"" or MK>0,2
  123.     Next 
  124.     Screen 2 : For A=0 To 7 : Colour A+8, Colour(A) : Next : Screen 0
  125.     Fade 1 To 2
  126.     For A=0 To 15 : Multi Wait : Next 
  127.     PAG=1-PAG
  128.   Loop 
  129.   For A=64 To 0 Step -2 : Extension_8_10C6 A : Multi Wait : Next 
  130.    Extension_8_10A8 
  131.   If I$=Chr$(27) Then Pop Proc[1]
  132. Pop Proc[0]
  133. ENTERHISC:
  134.   For A=15 To 1 Step -1
  135.     If SCORE>HISC(A,0) Then RANK=A Else Exit 
  136.   Next 
  137.   For A=14 To RANK Step -1
  138.     HISC$(A+1)=HISC$(A)
  139.     HISC(A+1,0)=HISC(A,0)
  140.     HISC(A+1,1)=HISC(A,1)
  141.   Next 
  142.   HISC$(RANK)=Space$(12)
  143.   HISC(RANK,0)=SCORE
  144.   HISC(RANK,1)=LEVEL
  145.   Gosub HISCORE
  146.   T[232,"You made it! Enter name!"]
  147.    Extension_8_128A 2
  148.    Extension_8_12B2 2,0 To 0,3
  149.    Extension_8_1258 : Wait Vbl 
  150.   Screen 2 : For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  151.   Fade 2 To 2
  152.   POS=1
  153.   NAME$=Space$(12)
  154.   Do 
  155.     Multi Wait 
  156.     I$=Inkey$
  157.     Exit If I$=Chr$(13)
  158.     If I$=Chr$(8) and POS>1 Then Dec POS : Mid$(NAME$,POS,1)=" "
  159.     If I$>Chr$(31) and POS<13 Then Mid$(NAME$,POS,1)=I$ : Inc POS
  160.     Screen 2
  161.     Text 92,104+RANK*8+TB,NAME$
  162.     Screen 0
  163.      Extension_8_12B2 2,0 To 0,3
  164.   Loop 
  165.   HISC$(RANK)=NAME$
  166.   Screen 2 : For A=0 To 7 : Colour A+8, Colour(A) : Next : Screen 0
  167.   Fade 1 To 2
  168.   For A=0 To 15 : Multi Wait : Next 
  169.   PAG=1-PAG
  170.   SAVHISC
  171. Return 
  172. CREDIZ:
  173.    Extension_8_121C 2,0
  174.   T[80,"Welcome to Tubes"]
  175.   T[104,"Written by Chris Hodges"]
  176.   T[128,"Instructions"]
  177.   T[144,"Simply build a pipeline by using"]
  178.   T[152,"the tube-parts that appear."]
  179.   T[160,"to make this more difficult, the"]
  180.   T[168,"time rather limited!"]
  181.   T[200,"This game was coded in one afternoon"]
  182.   T[224,"Enjoy..."]
  183. Return 
  184. HISCORE:
  185.    Extension_8_121C 2,0
  186.   T[80,"Best Tubers"]
  187.   T[96,"  Rank Name         Score Level"]
  188.   For A=1 To 15
  189.     T$= Extension_8_0EC8(A,2)+". "+HISC$(A)+" "+ Extension_8_0EB8(HISC(A,0),5)+" "+ Extension_8_0EB8(HISC(A,1),2)
  190.     T[104+A*8,T$]
  191.   Next 
  192. Return 
  193. End Proc
  194. Procedure T[Y,T$]
  195.   Screen 2
  196.   Text 160-Text Length(T$)/2,Y+TB,T$
  197.   Screen 0
  198. End Proc
  199. Procedure GAMEOVER
  200.   Shared SCORE
  201.   Screen 2 : For A=0 To 7 : Colour A+8, Colour(A) : Next : Screen 0
  202.   Fade 2 To 2
  203.   Screen 2
  204.    Extension_8_1204 11 : TB=Text Base
  205.    Extension_8_121C 2,0
  206.   T[128,"Game Over"]
  207.   T[160,"Score: "+ Extension_8_0EB8(SCORE,5)]
  208.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  209.    Extension_8_128A 2
  210.    Extension_8_12B2 2,0 To 0,3
  211.    Extension_8_1258 : Wait Vbl 
  212.   For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  213.   Fade 1 To 2
  214.   For A=1 To 150 : Multi Wait : Next 
  215. End Proc
  216. Procedure REBUILDGFX
  217.   Shared LEVEL
  218.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  219.   Cls 0
  220.   Screen Copy 1,0,16,320,80 To 0,0,0
  221.    Extension_8_1204 10
  222.   TB=Text Base
  223.   Ink 15,0 : Set Pattern -1
  224.   Bar 0,64 To 320,256
  225.   Put Block 6,0,64 : Put Block 6,15*16,64
  226.   Put Block 7,14*16,64 : Put Block 7,304,64
  227.   Put Block 8,0,240 : Put Block 8,15*16,240
  228.   Put Block 9,14*16,240 : Put Block 9,304,240
  229.   For A=1 To 13
  230.     Put Block 3,A*16,64
  231.     Put Block 3,A*16,240
  232.     If A<4
  233.       Put Block 3,A*16+15*16,64
  234.       Put Block 3,A*16+15*16,240
  235.     End If 
  236.   Next 
  237.   For A=5 To 14
  238.     Put Block 2,0,A*16
  239.     Put Block 2,14*16,A*16
  240.     Put Block 2,15*16,A*16
  241.     Put Block 2,304,A*16
  242.   Next 
  243.   Limit Mouse X Hard(16),Y Hard(80) To X Hard(14*16-1),Y Hard(15*16-1)
  244.   Screen 2
  245.    Extension_8_1204 11 : TB=Text Base
  246.    Extension_8_121C 2,0
  247.   T[128,"Get ready for Level"+Str$(LEVEL)]
  248.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  249.    Extension_8_128A 2
  250.    Extension_8_12B2 2,0 To 0,3
  251.    Extension_8_1258 : Wait Vbl 
  252.   For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  253.   Fade 1 To 2
  254.   For A=1 To 50 : Multi Wait : Next 
  255.   Screen 2 : For A=0 To 7 : Colour A+8, Colour(A) : Next : Screen 0
  256.   Fade 1 To 2
  257.   For A=1 To 32 : Multi Wait : Next 
  258.    Extension_8_121C 0,3
  259.   Fade 2 To 1
  260. End Proc
  261. Procedure SETTUBES
  262.   Shared NUMTUBES,LEVEL,SCORE,TIME
  263.   Shared WX,WY,SX,SY
  264.   For Y=0 To 9
  265.     For X=0 To 12
  266.       F(X,Y)=0
  267.     Next 
  268.   Next 
  269.   SX=Rnd(10)+1
  270.   SY=Rnd(7)+1
  271.   HOM=Rnd(3)+9
  272.   Put Block HOM+1,SX*16+16,SY*16+80
  273.   F(SX,SY)=HOM
  274.   If HOM=9 Then WX=0 : WY=1
  275.   If HOM=10 Then WX=0 : WY=-1
  276.   If HOM=11 Then WX=1 : WY=0
  277.   If HOM=12 Then WX=-1 : WY=0
  278.   Sam Loop Off 
  279.   Gr Writing 0
  280.   Ink 1,0
  281.   Text 260,80+TB,"Level"
  282.   Text 272,88+TB, Extension_8_0EB8(LEVEL,2)
  283.   Text 260,104+TB,"Score"
  284.   Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  285.   Text 260,128+TB,"Time:"
  286.   Text 260,152+TB,"Tubes"
  287.   Text 260,216+TB,"Next:"
  288.   TIE2=Rnd(7)+1
  289.   TIE3=Rnd(7)+1
  290.   TIE4=Rnd(7)+1
  291.   Timer=0
  292.   For PARTS=1 To NUMTUBES
  293.     Gr Writing 1
  294.     TIE=TIE2
  295.     TIE2=TIE3
  296.     TIE3=TIE4
  297.     If PARTS<NUMTUBES-2 Then TIE4=Rnd(7)+1 Else TIE4=0
  298.     Ink 1,0 : Text 260,160+TB, Extension_8_0EB8(PARTS,2)+"/"+ Extension_8_0EB8(NUMTUBES,2)
  299.     Ink 15,0 : Set Pattern -1 : Bar 256,224 To 303,239
  300.     If LEVEL<15 Then Put Block TIE2+1,256,224 Else Put Block 1,256,224
  301.     If LEVEL<10 Then Put Block TIE3+1,272,224 Else Put Block 1,272,224
  302.     If LEVEL<5 Then Put Block TIE4+1,288,224 Else Put Block 1,288,224
  303.     Repeat 
  304.       T=TIME-(Timer/50)
  305.       If OT<>T
  306.         T1=T/60 : T2=T mod 60
  307.         DUMMY$=Str$(T1)+Str$(T2)
  308.         OT=T
  309.         If T>10
  310.           Sam Play Extension_8_04F8(VO),7 : Add VO,1,0 To 2
  311.         Else 
  312.           Sam Play Extension_8_04F8(VO),8 : Add VO,1,0 To 2
  313.         End If 
  314.         Ink 1,0 : Text 260,136+TB, Extension_8_0EB8(T1,2)+":"+ Extension_8_0EB8(T2,2)
  315.         Exit If T=0,2
  316.       End If 
  317.       Multi Wait 
  318.       XM=(X Screen(X Mouse)-16)/16
  319.       YM=(Y Screen(Y Mouse)-80)/16
  320.       I$=Inkey$
  321.       If I$="p"
  322.         Fade 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  323.         TT=Timer
  324.         Repeat 
  325.           Multi Wait 
  326.           MK=Mouse Key
  327.           XM=(X Screen(X Mouse)-16)/16
  328.           YM=(Y Screen(Y Mouse)-80)/16
  329.           Sprite 0,X Hard(XM*16+16),Y Hard(YM*16+80),TIE+1
  330.         Until(Inkey$<>"") or(MK>0)
  331.         Repeat 
  332.           Multi Wait 
  333.           MK=Mouse Key
  334.         Until MK=0
  335.         Fade 1 To 1
  336.         Timer=TT
  337.       End If 
  338.       Exit If I$=Chr$(27),2
  339.       MK=Mouse Key
  340.       Sprite 0,X Hard(XM*16+16),Y Hard(YM*16+80),TIE+1
  341.       If F(XM,YM)>0 and(MK<>0)
  342.         Sam Play Extension_8_04F8(VO),4 : Add VO,1,0 To 2
  343.         Repeat 
  344.           Multi Wait 
  345.           MK=Mouse Key
  346.         Until MK=0
  347.       End If 
  348.     Until MK
  349.     Sam Play Extension_8_04F8(VO),5 : Add VO,1,0 To 2
  350.     F(XM,YM)=TIE
  351.     Put Block TIE+1,XM*16+16,YM*16+80
  352.     Sprite Off 
  353.     Repeat 
  354.       Multi Wait 
  355.       MK=Mouse Key
  356.     Until MK=0
  357.   Next 
  358.   Sprite Off 
  359.   TIME=T
  360. End Proc
  361. Procedure WATERGO
  362.   Shared SCORE,NUMTUBES,TIME,LEVDIF
  363.   Shared WX,WY,SX,SY
  364.   Ink 1,0 : Text 260,176+TB,"Done:"
  365.   X=7 : Y=7 : TUBES=0
  366.   Sam Loop Off 
  367.   Do 
  368.     Text 260,184+TB, Extension_8_0EC8(Min(TUBES*LEVDIF,NUMTUBES*100)/NUMTUBES,4)+"%"
  369.     Sam Play 8,1
  370.     OX=SX*16+16 : OY=SY*16+80
  371.     Repeat 
  372.        Extension_8_1016 OX+X-WY*5,OY+Y-WX*5 To OX+X+WY*4,OY+Y+WX*4,8,%1000
  373.       Wait Vbl 
  374.       Add X,WX : Add Y,WY
  375.       If X=7 and Y=7
  376.         F=Abs(F(SX,SY))
  377.         If P(F,2)=2
  378.           BX=X : BY=Y
  379.           Sam Play Extension_8_04F8(VO),3 : Add VO,1,0 To 2
  380.           For A=1 To 4
  381.              Extension_8_1016 OX+BX-WY*5,OY+BY-WX*5 To OX+BX+WY*4,OY+BY+WX*4,8,%1000
  382.             Wait Vbl 
  383.             Add BX,WX : Add BY,WY
  384.           Next 
  385.           Gosub CHECKCURVE
  386.         End If 
  387.       End If 
  388.     Until X<0 or X>15 or Y<0 or Y>15
  389.     If X<0 Then Dec SX : Add X,16
  390.     If Y<0 Then Dec SY : Add Y,16
  391.     If X>15 Then Inc SX : Add X,-16
  392.     If Y>15 Then Inc SY : Add Y,-16
  393.     Exit If SX<0 or SX>12 or SY<0 or SY>9
  394.     F=F(SX,SY) : F(SX,SY)=-Abs(F)
  395.     If F<0
  396.       Sam Play Extension_8_04F8(VO),6 : Add VO,1,0 To 2
  397.       F=-F
  398.       Add TUBES,3 : Add SCORE,100
  399.     End If 
  400.     If Y=0 Then R=0
  401.     If X=0 Then R=1
  402.     If X=7 and Y=7 Then R=2
  403.     If X=15 Then R=3
  404.     If Y=15 Then R=4
  405.     Exit If P(F,R)=0
  406.     Add SCORE,25
  407.     Gr Writing 1
  408.     Ink 1,0 : Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  409.     Inc TUBES
  410.   Loop 
  411.   Sam Stop 
  412.   Sam Loop Off 
  413.   Sam Play Extension_8_04F8(VO),2 : Add VO,1,0 To 2
  414.   For B=0 To 31
  415.     D(B,0)=X+SX*16+14+Rnd(4) : D(B,1)=Y+SY*16+78+Rnd(4)
  416.   Next 
  417.   For A=1 To 32
  418.     For B=0 To 31
  419.        Extension_8_0388 D(B,0),D(B,1), Extension_8_039E(D(B,0),D(B,1)) or 8
  420.       Add D(B,0),WX+(Rnd(2)-1)*WY
  421.       Add D(B,1),WY+(Rnd(2)-1)*WX
  422.     Next 
  423.   Next 
  424.   If TUBES*LEVDIF<NUMTUBES*100 Then Pop Proc[1]
  425.   If TIME
  426.     For T=TIME To 0 Step -1
  427.       Add SCORE,5
  428.       T1=T/60 : T2=T mod 60
  429.       DUMMY$=Str$(T1)+Str$(T2)
  430.       Ink 1,0 : Text 260,136+TB, Extension_8_0EB8(T1,2)+":"+ Extension_8_0EB8(T2,2)
  431.       Ink 1,0 : Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  432.       Sam Play Extension_8_04F8(VO),7 : Add VO,1,0 To 2
  433.       Wait 2
  434.     Next 
  435.   End If 
  436. Pop Proc[0]
  437. CHECKCURVE:
  438.   If P(F,0) and WY=0 Then WY=-1 : WX=0 : Return 
  439.   If P(F,1) and WX=0 Then WY=0 : WX=-1 : Return 
  440.   If P(F,3) and WX=0 Then WY=0 : WX=1 : Return 
  441.   If P(F,4) and WY=0 Then WY=1 : WX=0 : Return 
  442. Return 
  443. End Proc
  444. Procedure CLRHISC
  445.   For A=1 To 15
  446.     HISC(A,0)=(16-A)*1000
  447.     HISC(A,1)=(16-A)
  448.     HISC$(A)="NO NAME YET!"
  449.   Next 
  450. End Proc
  451. Procedure LOAHISC
  452.   If Exist("Tubes.his")=0 Then CLRHISC : SAVHISC : Pop Proc
  453.    Extension_8_0456 "Tubes.his",8
  454.   ST=Start(8)
  455.   For A=1 To 15
  456.     HISC$(A)=Peek$(ST,12) : Add ST,12
  457.     HISC(A,0)=Deek(ST) : Add ST,2
  458.     HISC(A,1)=Deek(ST) : Add ST,2
  459.   Next 
  460. End Proc
  461. Procedure SAVHISC
  462.   Reserve As Work 8,15*(12+2+2)
  463.   ST=Start(8)
  464.   For A=1 To 15
  465.     Poke$ ST,HISC$(A) : Add ST,12
  466.     Doke ST,HISC(A,0) : Add ST,2
  467.     Doke ST,HISC(A,1) : Add ST,2
  468.   Next 
  469.    Extension_8_0472 "Tubes.his",8
  470.   Erase 8
  471. End Proc